IDENTIFICATION DIVISION. PROGRAM-ID. OSCICS8C. DATE-WRITTEN. 09/17/96. DATE-COMPILED. ****************************************************************** ** ** (c) 1995 by Sybase, Inc. All Rights Reserved ** ****************************************************************** ****************************************************************** ** PROGRAM: OSCICS8C TRAN:SY8C.... ** ** THIS PROGRAM IS A THE OPEN SERVER VERSION OF RSP8C. RECEIVES ** A TEXT INPUT STRING(10,000 BYTES) AND RETURNS IT IN A 50 BYTE ** COLUMN ONE ROW AT A TIME... ** Example: exec sy8c 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx' ****************************************************************** ENVIRONMENT DIVISION. DATA DIVISION. WORKING-STORAGE SECTION. ****************************************************************** * COPY IN THE OS SERVER LIBRARYS ****************************************************************** * COPY SYGWCOB. ****************************************************************** *OPEN SERVER WORK VARIBLES FOR OS CALL TO USE ... ****************************************************************** 01 WS-GWL-WORK-VARIBLES. 05 GWL-PROC POINTER. 05 GWL-INIT-HANDLE POINTER. 05 GWL-RC PIC S9(9) COMP. 05 GWL-INFPRM-ID PIC S9(9) COMP. 05 GWL-INFPRM-TYPE PIC S9(9) COMP. 05 GWL-INFPRM-DATA-L PIC S9(9) COMP. 05 GWL-INFPRM-MAX-DATA-L PIC S9(9) COMP. 05 GWL-INFPRM-STATUS PIC S9(9) COMP. 05 GWL-INFPRM-NAME PIC X(30). 05 GWL-INFPRM-NAME-L PIC S9(9) COMP. 05 GWL-INFPRM-USER-DATA PIC S9(9) COMP. 05 GWL-INFUDT-USER-TYPE PIC S9(9) COMP. 05 GWL-STATUS-NR PIC S9(9) COMP. 05 GWL-STATUS-DONE PIC S9(9) COMP. 05 GWL-STATUS-COUNT PIC S9(9) COMP. 05 GWL-STATUS-COMM PIC S9(9) COMP. 05 GWL-COMM-STATE PIC S9(9) COMP. 05 GWL-STATUS-RETURN-CODE PIC S9(9) COMP. 05 GWL-STATUS-SUBCODE PIC S9(9) COMP. 05 GWL-NUMPRM-PARMS PIC S9(9) COMP. 05 GWL-RCVPRM-DATA-L PIC S9(9) COMP. 05 GWL-SETPRM-ID PIC S9(9) COMP. 05 GWL-SETPRM-TYPE PIC S9(9) COMP. 05 GWL-SETPRM-DATA-L PIC S9(9) COMP. 05 GWL-SETPRM-USER-DATA PIC S9(9) COMP. 05 GWL-CONVRT-SCALE PIC S9(9) COMP VALUE 2. 05 GWL-SETBCD-SCALE PIC S9(9) COMP VALUE 0. 05 GWL-INFBCD-LENGTH PIC S9(9) COMP. 05 GWL-INFBCD-SCALE PIC S9(9) COMP. 05 GWL-RETURN-ROWS PIC S9(9) COMP VALUE +0. 05 SNA-CONN-NAME PIC X(8) VALUE SPACES. 05 SNA-SUBC PIC S9(9) COMP. 05 WRK-DONE-STATUS PIC S9(9) COMP. 05 GWL-ACTUAL-LEN PIC S9(9) COMP. 05 GWL-TRAN-LEN PIC S9(9) COMP. 05 GWL-MSG-LEN PIC S9(9) COMP. 05 GWL-REQUEST-TYP PIC S9(9) COMP. 05 GWL-RPC-NAME PIC X(30) VALUE SPACES. 05 GWL-COMM-STATE PIC S9(9) COMP. 05 I PIC S9(9) COMP VALUE +0. 05 J PIC S9(4) COMP VALUE +0. 01 DESCRIPTION-FIELDS. 05 COLUMN-NUMBER PIC S9(09) COMP VALUE +0. 05 HOST-TYPE PIC S9(09) COMP VALUE +0. 05 HOST-LEN PIC S9(09) COMP VALUE +0. 05 COLUMN-LEN PIC S9(09) COMP VALUE +0. 05 COLUMN-NAME-LEN PIC S9(09) COMP VALUE +0. 01 WS-MSG-WORK-VARS. 05 MSG-NR PIC S9(9) COMP VALUE +9999. 01 WS-INPUT-LEN PIC s9(9) COMP VALUE +10000. 01 WS-INPUT-DATA-HDR. 03 WS-INPUT-DATA PIC X(10000) VALUE SPACES. 03 WS-INPUT-REDEFINE REDEFINES WS-INPUT-DATA. 05 WS-INPUT-TABLE OCCURS 10000 TIMES. 10 WS-INPUT-CHAR PIC X. 01 WS-OUTPUT-DATA-HDR. 03 WS-OUTPUT-DATA PIC X(50) VALUE SPACES. 03 WS-OUTPUT-REDEFINE REDEFINES WS-OUTPUT-DATA. 05 WS-OUTPUT-TABLE OCCURS 50 TIMES. 10 WS-OUTPUT-CHAR PIC X. 01 WS-OUTPUT-COL-NAME PIC X(13) VALUE 'OUTPUT_COLUMN'. ****************************************************************** * MESSAGES * ****************************************************************** 01 WS-MSG. 05 FILLER PIC X(17) VALUE 'ERROR IN OS CALL '. 05 WS-MSG-FUNC PIC X(10). 05 FILLER PIC X(04) VALUE 'RC='. 05 WS-MSG-RC PIC 9(9). 05 FILLER PIC X(18) VALUE ' SUBCODE ERROR = '. 05 MSG-SUBC PIC 9(9) VALUE 0. 05 WS-MSG-TEXT PIC X(50) VALUE SPACES. 01 WORK-SRVIN-INFO. 05 WK-INFO-TBL-ID PIC S9(8) COMP. 05 WK-INFO-TBL-NAME PIC X(30). 05 WK-INFO-TBL-VALUE PIC X(10). LINKAGE SECTION. ************************************************************** * THE LINKAGE SECTION DEFINES MASKS FOR DATA AREAS THAT ARE * PASSED BETWEEN THIS PROGRAM. ************************************************************** 01 DFHCOMMAREA PIC X(1). PROCEDURE DIVISION. 000-MAIN-PROCESSING. PERFORM 100-INITIALIZE THRU 100-EXIT. PERFORM 200-PROCESS-INPUT THRU 200-EXIT. PERFORM 300-PROCESS-OUTPUT THRU 300-EXIT. PERFORM 900-ALL-DONE THRU 900-EXIT. GOBACK. 000-EXIT. EXIT. 100-INITIALIZE. ****************************************************** * INTIALIZED THE TDS CONNECTION AND RECEIVE THE * RPC PARM........ ****************************************************** *==> ESTABLISH GATEWAY ENVIRONMENT <===* CALL 'TDINIT' USING DFHEIBLK, GWL-RC, GWL-INIT-HANDLE. IF GWL-RC NOT = TDS-OK THEN PERFORM 910-ERR-PROCESS THRU 910-EXIT END-IF. *==> ACCEPT CLIENT REQUEST <===* CALL 'TDACCEPT' USING GWL-PROC, GWL-RC, GWL-INIT-HANDLE, SNA-CONN-NAME, SNA-SUBC. IF GWL-RC NOT = TDS-OK THEN PERFORM 910-ERR-PROCESS THRU 910-EXIT END-IF. *==> TO MAKE SURE WE WERE STARTED BY RPC REQUEST... <===* CALL 'TDINFRPC' USING GWL-PROC, GWL-RC, GWL-REQUEST-TYP, GWL-RPC-NAME, GWL-COMM-STATE. IF GWL-RC NOT = TDS-OK OR GWL-REQUEST-TYP NOT = TDS-RPC-EVENT THEN MOVE GWL-RC TO WS-MSG-RC MOVE 'TDINFRPC' TO WS-MSG-FUNC PERFORM 920-SEND-MESSAGE THRU 920-EXIT PERFORM 910-ERR-PROCESS THRU 910-EXIT END-IF. 100-EXIT. EXIT. 200-PROCESS-INPUT. **************************************************************** * RECEIVE THE INPUT PARAMETER INTO HOST VARIBLE **************************************************************** *---> Find out how many parms are being passed <---* CALL 'TDNUMPRM' USING GWL-PROC, GWL-NUMPRM-PARMS. *---> More than one pump back a message <---* IF GWL-NUMPRM-PARMS not = +1 THEN MOVE 'Invalid Number of Parameters' TO WS-MSG-TEXT MOVE GWL-RC TO WS-MSG-RC MOVE 'TDNUMPRM' TO WS-MSG-FUNC PERFORM 920-SEND-MESSAGE THRU 920-EXIT PERFORM 910-ERR-PROCESS THRU 910-EXIT END-IF *---> Get that parm into into the host varible <---* IF GWL-NUMPRM-PARMS = +1 THEN CALL 'TDRCVPRM' USING GWL-PROC, GWL-RC, GWL-NUMPRM-PARMS, WS-INPUT-DATA, TDSLONGVARCHAR, WS-INPUT-LEN, GWL-ACTUAL-LEN IF GWL-RC NOT = TDS-OK THEN MOVE GWL-RC TO WS-MSG-RC MOVE 'TDRCVPRM' TO WS-MSG-FUNC PERFORM 920-SEND-MESSAGE THRU 920-EXIT PERFORM 910-ERR-PROCESS THRU 910-EXIT END-IF END-IF. 200-EXIT. EXIT. 300-PROCESS-OUTPUT. **************************************************************** * BREAK UP THE 10K INPUT FIELDS INTO A 50 BYTE COLUMN AND SEND **************************************************************** MOVE +1 TO COLUMN-NUMBER. MOVE LENGTH OF WS-OUTPUT-DATA TO HOST-LEN COLUMN-LEN. MOVE LENGTH OF WS-OUTPUT-COL-NAME TO COLUMN-NAME-LEN. CALL 'TDESCRIB' USING GWL-PROC, GWL-RC, COLUMN-NUMBER, TDSCHAR, HOST-LEN, WS-OUTPUT-DATA, TDS-ZERO, TDS-FALSE, TDSCHAR, COLUMN-LEN, WS-OUTPUT-COL-NAME, COLUMN-NAME-LEN. IF GWL-RC NOT = TDS-OK THEN MOVE GWL-RC TO WS-MSG-RC MOVE 'TDESCRIB' TO WS-MSG-FUNC PERFORM 920-SEND-MESSAGE THRU 920-EXIT PERFORM 910-ERR-PROCESS THRU 910-EXIT END-IF. PERFORM VARYING I FROM 1 BY 1 UNTIL I > GWL-ACTUAL-LEN COMPUTE J = J + 1 MOVE WS-INPUT-CHAR(I) TO WS-OUTPUT-CHAR(J) IF J = 50 THEN PERFORM 310-SEND-ROW THRU 310-EXIT MOVE ZERO TO J MOVE SPACES TO WS-OUTPUT-DATA END-IF END-PERFORM. IF J > ZERO THEN PERFORM 310-SEND-ROW THRU 310-EXIT. 300-EXIT. EXIT. 310-SEND-ROW. **************************************************************** * SEND ROW OF DATA TO CLIENT.... ***************************************************************** CALL 'TDSNDROW' USING GWL-PROC, GWL-RC IF GWL-RC NOT = TDS-OK THEN MOVE GWL-RC TO WS-MSG-RC MOVE 'TDSNDROW' TO WS-MSG-FUNC PERFORM 920-SEND-MESSAGE THRU 920-EXIT PERFORM 910-ERR-PROCESS THRU 910-EXIT END-IF. 310-EXIT. EXIT. EJECT 900-ALL-DONE. ****************************************************************** * CLOSE CONNECTION TO CLIENT AND RETURN TO CICS... * ****************************************************************** CALL 'TDSNDDON' USING GWL-PROC, GWL-RC, WRK-DONE-STATUS, GWL-RETURN-ROWS, TDS-ZERO, TDS-ENDRPC. IF GWL-RC NOT = TDS-OK THEN PERFORM 980-CICS-DUMP THRU 980-EXIT PERFORM 990-CICS-RETURN THRU 990-EXIT END-IF. CALL 'TDFREE' USING GWL-PROC, GWL-RC. PERFORM 990-CICS-RETURN THRU 990-EXIT. 900-EXIT. EXIT. 910-ERR-PROCESS. ****************************************************************** * PERFORM ALL-DONE IN A ERROR STATE * ****************************************************************** MOVE ZERO TO GWL-RETURN-ROWS. MOVE TDS-DONE-ERROR TO WRK-DONE-STATUS. PERFORM 900-ALL-DONE THRU 900-EXIT. 910-EXIT. EXIT. 920-SEND-MESSAGE. ****************************************************************** * SEND ERROR MESSAGE DOWN TO CLIENT * ****************************************************************** CALL 'TDSTATUS' USING GWL-PROC, GWL-RC, GWL-STATUS-NR, GWL-STATUS-DONE, GWL-STATUS-COUNT, GWL-STATUS-COMM, GWL-STATUS-RETURN-CODE, GWL-STATUS-SUBCODE. *==> ENSURE THAT WE ARE IN THE CORRECT STATE TO SEND A MESSAGE <=* IF GWL-RC NOT = TDS-OK THEN PERFORM 980-CICS-DUMP THRU 980-EXIT PERFORM 990-CICS-RETURN THRU 990-EXIT END-IF. IF GWL-STATUS-COMM = TDS-RECEIVE THEN CALL 'TDCANCEL' USING GWL-PROC, GWL-RC. MOVE LENGTH OF EIBTRNID TO GWL-TRAN-LEN. MOVE LENGTH OF WS-MSG TO GWL-MSG-LEN. CALL 'TDSNDMSG' USING GWL-PROC, GWL-RC, TDS-ERROR-MSG, MSG-NR, TDS-ERROR-SEV, TDS-ZERO, TDS-ZERO, EIBTRNID, GWL-TRAN-LEN, WS-MSG, GWL-MSG-LEN. 920-EXIT. EXIT. 980-CICS-DUMP. ****************************************************************** * CAUSE A CICS TRANSACTION DUMP USUALLY BECAUSE SOMETHING IS BAD * ****************************************************************** EXEC CICS DUMP DUMPCODE('SY8C') NOHANDLE END-EXEC. 980-EXIT. EXIT. 990-CICS-RETURN. ****************************************************************** * RETURN TO CICS... * ****************************************************************** EXEC CICS RETURN END-EXEC. 990-EXIT. EXIT.